perm filename PFAIL.FAI[PAG,LCS]17 blob sn#513520 filedate 1980-05-23 generic text, type T, neo UTF8
00100		TITLE PFAIL; ********* OCT 78 *********
00200		INTERNAL PUTEXT,EXTOUT,GETEXT,EXTIN,FINEXT,INMUS
00300		ENTRY LOOKF,LOOKX,LOOK,SHFTQ,SORT2,NORH,FNDEND,MINMAX
00400		ENTRY RLOOP,BLTEM,IFIX,FLOAT,RCURVE
00500	;;	ENTRY PFIBX,PFIB,RLOOP,BLTEM,IFIX,FLOAT
00600		ENTRY GETPTS,MOVIT,EXTEN,DBAR,QRN,SORT,SHIFT,SHFT1,SHFT0
00700		ENTRY PSHFT,ADRST,STAFF,RIGHT,RESTS,EXCHG,EXCH,SHRNK,EXPND,CLFNUM
00800		ENTRY SLRV,CLEFN,MMNN,CODEN,ZERO,BARFAC
00900		EXTERNAL .COMM.,XRN,KJY,PTR,POSI,AMOD,KNR,NNP,PX,XXX,Q,SF,LLL
01000		EXTERNAL RCLF,STF,PTMOVE,IPG,JN,RCLF,MNX,ALOG,ENDL
01100	DEFINE ERROR (MSG)
01200	<	JSA 16,.ERROR
01300		JUMP [ASCIZ/MSG/
01400	]
01500	>
01600	
01700	.ERROR:	0
01800		OUTSTR [ASCIZ/?
01900	/]				;MAKE SURE HE CAN SEE HIS ERROR
02000		OUTSTR @(16)		;OUTPUT ERROR MESSAGE
02100		CALLI 1,12		;LET USER CONTINUE
02200		JRA 16,1(16)
02300	
02400		CH←13
02500	
02600	REGS:	BLOCK 20
02700	
02800	;LOOK(<FILE>) FOR NO EXT., LOOKD() FOR .DAT, LOOKF() FOR .MS 
02900	LOOKF:	0
03000		MOVSI 0,'MS '
03100		JRST LOOK1
03200	LOOKX:	0
03300		MOVE	0,@1(16)
03400		MOVEM 	0,FILNAM
03500		JSA 16, INTFIQ
03600		MOVE 0,DIR
03700		JRST LOOK1
03800	LOOK:	0
03900		MOVEI	0,0
04000	LOOK1:	MOVEM	0,DIR+1
04100		MOVE	0,@(16)
04200		MOVEM 	0,FILNAM
04300		JSA 16, INTFIQ
04400		SETZM	DIR+2
04500		SETZM	DIR+3
04600		LOOKUP	CH,DIR
04700		TDZA	0,0
04800		MOVNI	0,1
04900		JRA 16,1(16)
05000	
05100	INTFIQ:	0	;INITS DSK FOR INPUT
05200		MOVEI REGS
05300		BLT REGS+3
05400		INIT CH,17
05500		SIXBIT/DSK/
05600		0
05700		HALT .-3
05800	;	ERROR <CAN'T INIT DSK!>
05900		PUSHJ 17,INTF4
06000		JRA 16,0(16)
06100	
06200	INTF4: 	MOVE 0,FILNAM#
06300		MOVEM 0,FN#
06400		MOVE 1,[POINT 7,FN]
06500	INTF3:	MOVE 2,[POINT 6,DIR]
06600		SETZM DIR
06700		MOVEI 3,5
06800	INTF1:	ILDB 0,1
06900		CAIN 0," "
07000		JRST INTF2
07100		SUBI 0,40
07200		IDPB 0,2
07300		SOJG 3,INTF1
07400	INTF2:	HRLZI REGS
07500		BLT 4
07600		POPJ 17,
07700	
07800	DIR:	BLOCK 4
07900	
08000	SHFTQ:	0		;CALL SHFTQ(R)
08100		MOVE JN+1	
08200		SOS
08300		SETZ 1,
08400		MOVE 3,@(16)	;R
08500	SHQ:	MOVE 2,XRN(1)
08600		FADRM 3,Q-1(2)
08700		CAMGE 1,0
08800		AOJA 1,SHQ
08900		JRA 16,1(16)
09000	
09100	SORT2:	0		;SUBROUTINE SORT2(RPOS,M)
09200		MOVEI	2,2	;DIMENSION RPOS(2,200)
09300	SO3:	MOVE	6,2	;(K=L HERE)
09400		SETO	11,	;L=2
09500		HRRZI	3,@(16)	;3	J=-1
09600		MOVE	4,2	;RX=RPOS(1,L-1)
09700		SUBI	4,1	;L-1
09800		IMULI	4,2
09900		ADDI	4,(3)
10000		MOVE	5,-2(4)	;RX
10100	SO2:	MOVE 	7,6	;	DO 2 K=L,M
10200					;IF(RPOS(1,K).GE.RX)GO TO 2
10300		IMULI	7,2	;IF(RPOS(1,K).GE.RX)GO TO 2
10400		ADDI	7,(3)
10500		CAMG	5,-2(7)
10600		JRST	SO1	; CONTINUE
10700		MOVE	5,-2(7)	;  RX=RPOS(1,K)
10800	;;C   WHY WERE ALL THE RX'S  JX ????? 9/6/73
10900		MOVE 	11,6	;J=K
11000	SO1:	CAMGE	6,@1(16)	;2	CONTINUE
11100		AOJA	6,SO2
11200		JUMPL	11,SO4	;IF(J)GO TO 4
11300		MOVE	12,2	;K=L-1
11400		SOS	12
11500		IMULI	12,2	;(K*2)
11600		ADD	12,3	;CALL EXCH(RPOS(1,K),RPOS(1,J))
11700		MOVE	10,-2(12)
11800		IMULI	11,2
11900		ADD	11,3
12000		EXCH	10,-2(11)
12100		MOVEM	10,-2(12)
12200		MOVE	10,-1(12)	;CALL EXCH(RPOS(2,K),RPOS(2,J))
12300		EXCH	10,-1(11)
12400		MOVEM	10,-1(12)
12500	SO4:	CAMGE	2,@1(16)	;4	L=L+1
12600		AOJA	2,SO3		;IF(L.LE.M)GO TO 3
12700		JRA	16,2(16)	;END
12800	
12900	NORH:	0 		;FUNCTION NORH(KK)
13000		MOVE 15,@1(16)	;NOW**** FUNCTION NORH(KK,K)
13100		MOVE 1,XRN+=499(15)  ;FIND VALUE IN NN ARRAY IN DO LOOP.
13200		MOVEM 1,@(16)		;KK=NN(K)
13300		SETZ 0,
13400		JUMPLE 1,NOR
13500		CAILE 1,2		;NORH=-1 IF KK≤0, >18, NOT 1,2,4,17.
13600		CAIN 1,4
13700		JRA 16,1(16)
13800		CAIE 1,=18		;USED IN RESPC.F4
13900		CAIN 1,=17
14000		JRA 16,1(16)
14100	NOR:	SETO 0,
14200		JRA 16,1(16)
14300	
14400	FNDEND:	0		;CALL FNDEND(R)
14500		SETZ 1,
14600	FA:	MOVE 2,XRN+=500(1)	;NN(K)
14700		JUMPLE 2,FB
14800		CAIG 2,3
14900		JRST FC
15000		CAIE 2,=17
15100		CAIN 2,=18
15200		SKIPA
15300	FB:	AOJA 1,FA	;ASSUMES IT WILL ALWAYS END PROPERLY!!!
15400	FC:	MOVN 2,XRN(1)	; MM(K)
15500		FADR 2,[2.0]
15600		FADR 2,ENDL   	;+ENDLN
15700	;;	FADR 2,RSP+=20	;+ENDLN
15800		MOVEM 2,@(16)
15900		JRA 16,1(16)
16000	
16100	MINMAX:	0	;	SUBROUTINE MINMAX(JRN)
16200		MOVEI 1,@(16)  ;COMMON /MNX/MIN,MAX,JT  DIM. JRN(1)
16300	;;	MOVE 1,0	;	COMMON /MNX/MIN,MAX,JT /XRN/JRN(1)
16400		MOVE 0,(1)	;GET FIRST VALUE OF CURRENT JRN ARRAY
16500		MOVE  3,
16600		MOVEI 2,2	;	MIN=10000
16700	;;MM:	CAMLE 0,XRN-1(2)	;	MAX=0
16800	MM:	CAMLE 0,1(1)    	;	MAX=0
16900		MOVE 0,1(1)     ;	DO 107 K=1,JT
17000		CAMGE 3,1(1)     	;	NN=JRN(K)
17100		MOVE 3,1(1)    	;	IF(NN.LT.MIN)MIN=NN
17200		AOJ 1,
17300		CAMGE 2,MNX+2
17400		AOJA 2,MM	;107	IF(NN.GT.MAX)MAX=NN
17500		MOVEM 0,MNX	;	END
17600		MOVEM 3,MNX+1
17700		JRA 16,1(16)
17800	
17900	PFIBX:	0	;DATA FIB/0.618/, RFIB/-.382/,ALG/0.30103/
18000			;100	ACCEPT 10,A   10	FORMAT(F)
18100		MOVE 12,@(16)		;PFIBX=14
18200		MOVE 13,[14.0]		;IF(A.EQ.1)GO TO 20
18300		CAMN 12,[1.0]		;Z=FIB
18400		JRST PFX		;IF(A.LT.1)Z=RFIB
18500		JSA 16,ALOG		;RH=ABS(ALOG(A)/ALOG(2.0))
18600		JUMP 12
18700		FDVR 0,[0.6931472]
18800		MOVM 11,0
18900		MOVE 10,[0.618]
19000		SKIPG    		;L=RH
19100		MOVN 10,[0.382]		;IF(L.EQ.0)GO TO 4
19200		KIFIX 7,11
19300		MOVE 6,7		;SAVE L FOR LATER
19400		JUMPE 6,PFZ
19500	PF:	MOVE 2,13		;	DO 3 K=1,L
19600		FMPR 2,10		;3	PFIBX=PFIBX+PFIBX*Z
19700		FADR 13,2
19800		SOJG 6,PF
19900	PFZ:	FLTR 7,7		;4	RH=RH-L
20000		FSBR 11,7		;IF(RH.EQ.0)GO TO 20
20100		JUMPE 11,PFX	
20200		MOVE 2,13
20300		FMPR 2,10
20400		FMPR 2,11		;PFIBX=PFIBX+PFIBX*Z*RH
20500		FADR 13,2
20600	PFX:	MOVE 0,13		;SEND BACK THE RESULT
20700		JRA 16,1(16)
20800	
20900	PFIB:	0		;FUNCTION PFIB(P)  PSEUDO-FIBONACCI RHYTHM SPACER
21000		MOVN 0,@(16)	;PFIB=(P+(.125-P)*(.8+.01*P))*50
21100		FADR 0,[0.125]	;END
21200		MOVE 1,@(16)
21300		FMPR 1,[0.02]
21400		FADR 1,[0.8]
21500		FMPR 0,1
21600		FADR 0,@(16)
21700		FMPR 0,[50.0]
21800		JRA 16,1(16)
21900	
22000	RLOOP:	0		;CALL RLOOP(A,B,K)
22100		HRLI 1,@1(16)	;DIMENSION A(1),B(1)  --  SOURCE
22200		HRRI 1,@(16)	;DO 1 J=1,K     -- DESTINATION
22300		MOVEI 2,@(16)    ;1	A(J)=B(J)  -- WORD COUNT
22400		ADD  2,@2(16)  ;LOC OF ARRAY A + WDCNT.
22500		BLT  1,-1(2)
22600		JRA 16,3(16)
22700	
22800	BLTEM: 	0
22900		HRLI 1,PX	;KWDS(...)=KPN(...)  PX IS LOC. OF KPN ARRAY
23000		HRRI 1,PTR	;RIGHT HALF IS LOC OF KWDS ARRAY
23100		MOVE 2,RCLF+3	;GET NUM. OF ITEMS  (RCLF+3=ITEM)
23200		BLT 1,PTR(2)	; PTR(2) IS WD CNT.   (ITEM+1)
23300		HRLI 1,Q	;RN(...)=Q(...)
23400		HRRI 1,XRN
23500		MOVE 2,POSI+=9	;THIS IS JPQ, NUM OF WDS.
23600		BLT 1,XRN-1(2)
23700		JRA 16,0(16)
23800	
23900	IFIX:	0
24000		KIFIX 0,@(16)
24100		JRA 16,1(16)
24200	FLOAT:	0
24300		FLTR 0,@(16)
24400		JRA 16,1(16)
24500	
24600	  K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
24700	
24800	; 	SUBROUTINE GETPTS
24900	;	COMMON/KNR/N(500) /NNP/NP(500)
25000	;XXX	COMMON/XRN/RN(4000)  /KJY/ K,J
25100	;	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS
25200	;XXX	1/PTR/PWDS(250),ITEM,LL,I,IX
25300	;	EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
25400	;	1,(R6,RJQ(4))
25500	
25600	GETPTS:	0		;CALL GETPTS(N,RN,PWDS)
25700		SETZ	J,	;	J=0
25800		SETZ	K,	;	K=0
25900		MOVE 	JJ2,POSI+=8
26000		KIFIX	R2,.COMM.	;GET THE STAFF NUM. (NEG= ALL IN THIS PROG.)
26100		SETZ	X,
26200		MOVEI 	M,@2(16);	DO 1 M=1,ITEM
26300	G1:	AOJ	X,
26400		MOVE	L,(M)
26500		MOVEI 	R,@1(16)	;L=PWDS(M)
26600		ADDI	R,(L)		;IF(RTLINE(L))GO TO 1
26700	
26800		JUMPL R2,G9		;NEG R2=ALL STAVES
26900		KIFIX A,1(R)		;CHECK NOW FOR CORRECT STAFF
27000		CAME R2,A
27100		JRST GX			;NOT THE ONE.
27200	
27300	;*	MOVE	1,1(R)		;RN(L+2)
27400	;;NEVER USED IN 'PARTS'-	CAML	R2,[=5.0]
27500	;;	JRST	GZ
27600	;PT	MOVE A,1(R)
27700	;;	SKIPE IPG		;IF(IPG)GO TO GSTF
27800	;;	JRST GSTF
27900	;;	KIFIX A,A
28000	;;	FLTR A,A		;STAFF=IFIX(STAFF)  DROPS DECIS.
28100	;PT	SKIPL IPG
28200	;PT	JRST G9
28300	;PTGSTF:	CAME	R2,A   		;FINDS STAFF #
28400	;PT	JRST 	GX
28500	;;GZ:	MOVE	A,.COMM.+7		;RY=RN(L+1)
28600	;;	JUMPLE	A,G9			;F(R6.LE.0)GO TO 9
28700	;;	CAME	A,(R)		;IF(R6.NE.RY)GO TO 1
28800	;;	JRST	GX
28900	;  CHECK CODE NUM
29000	G9:	MOVE	A,2(R)
29100		CAMG	A,.COMM.+6	;R5  9	IF(OUTLIM(R4,R5,RN(L+3)))GO TO 2
29200		CAMGE	A,.COMM.+5	;R4
29300		JRST	G2
29400	
29500		SKIPG	JJ2
29600		MOVE	JJ2,X
29700		MOVE	.COMM.+=8	;IF(IPG)RN(L+2)=R7
29800		AOJ	J,
29900	;  IN LIMITS?
30000	;	MOVEI	A,XRN+=2498	;J=J+1
30100	;;	MOVEI	A,KNR-1
30200	;;	ADDI	A,(J)
30300		MOVEI	0,(L)
30400		AOJ	K,		;K=K+1
30500	;;	MOVEI	1,NNP-1
30600	;;	ADDI	1,(K)		;NP(K)=L
30700		MOVEM	0,NNP-1(K)
30800		ADDI	0,3		;N(J)=L+3
30900		MOVEM	0,KNR-1(J)
31000	;  NP IS FOR USE IN JUSTIFY ROUTINE
31100	G2:	KIFIX	RY,(R)	;2	IF(RY.LT.4)GO TO 1
31200		CAIN	RY,2   	;IF(RY.EQ.2)GO TO GRST
31300		JRST GRST
31400		CAIGE	RY,4
31500		JRST	GX
31600		MOVE	RZ,-1(R)	;RZ=RN(L)     WD CNT
31700		CAIE	RY,=44	;CODE 4 IS SOMETIMES =44
31800		JRST .+4
31900		CAMG RZ,[2.0]	  ;IF(RZ.LE.2)THEN IT'S AN CODE 44 BAR LINE.
32000		JRST GX
32100		JRST	G5		;FOUND A LINE
32200		CAILE	RY,7
32300		JRST	GX		;IF(RY.GT.7)GO TO 1
32400	;  TWO-ENDED ITEM?
32500	;;	CAMN	RY,[=4.0]	;GO TO(4,5,6,7),IFIX(RY)-3
32600	;;	JRST	G4
32700	;;	CAMN	RY,[=5.0]
32800	;;	JRST	G5
32900	;;	CAMN	RY,[=6.0]
33000	;;	JRST	G6
33100	;;	CAMG	RZ,[=4.0]	;4	IF(RZ.GT.2)GO TO 5
33200	;;	JRST	G5		; THERE IS A TRILL WIGGLE
33300	;;	JRST	GX		;GO TO 1   -- NO WIGGLE (P7≠0)
33400		XCT TBL-4(RY)	; NEXT REPLACES THE ABOVE.
33500		JRST G5
33600		JRST GX
33700	TBL:	JRST G4
33800		JRST G5
33900		JRST G6
34000		CAMG RZ,[4.0]
34100	
34200	G4:	CAMG	RZ,[=3.0]	;7	IF(RZ.GT.3)GO TO 5
34300		JRST	GX
34400		JRST	G5		;GO TO 1
34500	GRST:	MOVE RZ,-1(R)		;FOR 'CENTERED' RESTS
34600		JRST G8
34700	G6:	CAMGE	RZ,[=8.0]	;6	IF(RZ.LT.8)GO TO 8
34800		JRST	G8
34900		SKIPL 6(R)	;IF(R7)GO TO 8
35000		SKIPN =9(R)	;IF(R10.EQ.0)GO TO 8
35100		JRST	G8
35200	;;	MOVE	A,7(R)	  ; IF(OUTLIM(R4,R5,RN(L+8)))GO TO 8
35300	;;	JUMPE A,G5	;IF(R8.EQ.0)GO TO G5(MOVE ONLY P3,6)
35400		SKIPG A,7(R)		;IGNORE P8 IF IT IS 0 OR -
35500		JRST G8
35600		CAMG	A,.COMM.+6
35700		CAMGE	A,.COMM.+5
35800		JRST	G8
35900		CAMLE JJ2,X
36000		MOVE	JJ2,X
36100		AOJ	J,    ;  IN LIMITS?
36200		MOVEI	0,=8(L)		;J=J+1
36300		MOVEM 0,KNR-1(J)
36400	G8:	CAML	RZ,[=7.0]	;8	IF(RZ.LT.7)GO TO 5
36500		SKIPG A,8(R)	; R9	IF(R9.LE.0)GO TO G5
36600		JRST G5
36700		CAIE RY,2	;IF(RY.EQ.2)GO TO GRST2  (NEW CENTERED RESTS)
36800		SKIPE 7(R)	; R8
36900		JRST GRST2
37000		SKIPL 6(R)	; R7
37100		JRST G5
37200	GRST2:	CAMG	A,.COMM.+6
37300		CAMGE	A,.COMM.+5	;R4
37400		JRST	G5
37500	
37600		CAMLE JJ2,X
37700		MOVE	JJ2,X
37800		AOJ	J,		;J=J+1   ;  IN LIMITS?
37900		MOVEI	0,=9(L)
38000		MOVEM 0,KNR-1(J)	;N(J)=L+9
38100	G5:	CAIN	RY,2   	;IF(RY.EQ.2)GO TO GX  
38200		JRST GX  
38300		MOVE	A,5(R)
38400		CAMG	A,.COMM.+6
38500		CAMGE	A,.COMM.+5	;R4
38600		JRST	GX
38700	
38800		CAMLE JJ2,X
38900		MOVE	JJ2,X
39000		AOJ	J,     ;  IN LIMITS?
39100	;|	MOVEI	A,XRN+=2498	;J=J+1
39200	;;	ADDI	A,(J)
39300		MOVEI	0,6(L)  ;5	IF(OUTLIM(R4,R5,RN(L+6)))GO TO 1
39400	;;	ADDI	0,6		;N(J)=L+6
39500		MOVEM	0,KNR-1(J)
39600	;;GX:	CAMGE	X,PTR+=250	;1	CONTINUE
39700	GX:	CAMGE	X,LLL		;1	CONTINUE
39800		AOJA	M,G1
39900		MOVEM	JJ2,POSI+=8
40000		MOVEM	J,KJY+1
40100		MOVEM	K,KJY
40200		JRA	16,3(16)
40300	
40400	;	SUBROUTINE MOVIT(RN,NP,R4,R5,R8,R9)
40500	;	DIMENSION  NP(1),RN(1)
40600	;	COMMON  /KJY/ DONT,J
40700	MOVIT:	0		;RDIS=(R9-R8)/(R5-R4)
40800		MOVE	R,@5(16)    
40900		FSBR	R,@4(16)    
41000		MOVE	RY,@3(16)   
41100		FSBR	RY,@2(16)   
41200		FDVR	R,RY
41300	;	MOVEI	L,XRN+=2499	;	DO 1 K=1,J
41400		MOVEI	L,@1(16)	; GET NP ARRAY LOC
41500		SETZ	K,
41600		MOVE	0,@5(16)     	; SET UP R9
41700	;;M1:	MOVE	X,L	       ;	L=NP(K)
41800	M1:	MOVEI  	R2,@(16)	;RA=RN(L)
41900		ADD 	R2,(L)
42000		MOVEI	RZ,(R2)
42100		MOVE	R2,-1(R2)
42200		CAML	R2,@2(16)   	;IF(OUTLIM(R4,R5,RA))GO TO 1
42300		CAMLE	R2,@3(16)   
42400		JRST	MX
42500		JUMPE	0,M2	;IF(R9.NE.0)RA=(RA-R4)*RDIS
42600		FSBR	R2,@2(16)   
42700		FMPR	R2,R 
42800	M2: 	FADR	R2,@4(16)    	;	RN(L)=R8+RA
42900		MOVEM	R2,-1(RZ)
43000	MX:	AOJ	K,		;1	CONTINUE
43100		CAMGE	K,KJY+1
43200		AOJA	L,M1
43300		JRA	16,6(16)
43400	
43500	
43600	EXTEN:	0	;FUNCTION EXTEN(X)
43700		HRRM	16,.+2
43800		JSA	16,AMOD	;EXTEN=AMOD(X,1.)*10.
43900		JUMP 	@0
44000		JUMP	[=1.0]
44100		FMPR	[=10.0]
44200		JRA	16,1(16)
44300	
44400	DBAR:	0	; CALL DBAR(K,ITEM,J)
44500		MOVE 4,@2(16)	; -J-RR=RN(J+3)
44600	;PT	SKIPL IPG		;IF(IPG.GE.0)LEAVE BAR ALONE!
44700		JRST DB1
44800	;PT	KIFIX 2,XRN+3(4)		; -RN(J+4)-
44900		        		;KZ=RN(J+4)/100.
45000	;PT	IMULI 2,=100		;RN(J+4)=1.+KZ*100.
45100	
45200	DB1:	MOVE 1,@1(16)
45300		MOVE 7,XRN+2(4)		; -RR-
45400		MOVE 4,@(16)	;	DO 82 KY=K+1,ITEM
45500	DB:	MOVE 5,PTR(4)	;KZ=PWDS(KY)
45600		MOVE 6,XRN(5)	;	IF(RN(KZ+1).NE.4)GO TO 82
45700		CAME 6,[4.0]
45800		JRST DB82
45900		MOVE 6,XRN-1(5)	;IF(RN(KZ).GT.3)GO TO 82
46000		CAMLE 6,[3.0]
46100		JRST DB82
46200	;;C  AVOIDS DUPLICATE BARS.
46300		MOVN 6,XRN+2(5)  ;IF(ABS(RR-RN(KZ+3)).GT..5)GO TO 82	
46400		FADR 6,7
46500		SKIPGE 6
46600		MOVNS 6
46700		CAMLE 6,[0.5]
46800		JRST DB82
46900		MOVE 6,[99.0]  ;RN(KZ+2)=99
47000		MOVEM 6,XRN+1(5)
47100		SETZM XRN(5)	;RN(KZ+1)=0
47200	DB82:	AOJ 4,  ;82	CONTINUE
47300		CAIGE 4,(1)
47400		JRST DB
47500		MOVEM 7,DBX# 	; RR   SAVES IT FOR ADRST ROUTINE
47600		JRA 16,3(16)
47700	
47800	QRN:	0	; CALL QRN(J,XWDS,K)
47900		MOVE 4,@(16)	;810	JA=PWDS(K+1)
48000	
48100	PN4:	MOVE 5,@2(16)	;	DO 7 KY=J,JA-1
48200		MOVE 5,PTR(5)		; - JA -
48300		MOVE 6,XXX	;	PN(LK)=RN(KY)
48400		MOVEI 1,(6)		; SAVE IT FOR A LITTLE LATER
48500	PN:	MOVE 7,XRN-1(4)	;7	LK=LK+1
48600		MOVEM 7,Q-1(6)
48700		AOJ 4,			;AC4 IS KY, AC6 IS LK
48800		CAME 4,5
48900		AOJA 6,PN
49000		SKIPN SF		;IF(KL.EQ.0)GO TO PN5
49100		JRST PN5
49200		MOVE [1.0]		;PUT A 1.0 AS RHYTHM FOR REST OR NOTE
49300		ADD 6,SF
49400		MOVEM Q-1(6)		;PUT IT IN PARAM 7 OR 9
49500	PN5:	AOJ 6,
49600		MOVE 2,.COMM.+6		;	IF(R5)GO TO 6666
49700		JUMPL 2,PN2	;	IF(PN(J).EQ.2)LK=LK+1
49800		MOVEM 2,Q+4(1)		;	PN(J+5)=R5
49900		MOVE 3,[3.0]
50000	PN3:	MOVE 4,3		; IS THE WDCNT BIG ENOUGH?
50100		FSBR 4,Q-1(1)
50200		KIFIX 4,4
50300		ADD 6,4		; UPDATE THE MAIN COUNTER
50400	;PT???	SETZM Q+3(1)	; ZERO PARAM 4, THE VERTICAL POS.  PN(J+4)
50500		MOVEM 3,Q-1(1)		;	PN(J)=3 OR 4
50600		JRST PN1
50700	PN2:	MOVE 3,RCLF	; IF(R.NE.17)GO TO
50800		CAME 3,[17.0]
50900		JRST PN1
51000		MOVE 3,[4.0]	; THE WDCNT
51100		MOVE 2,RCLF+1  	; CLEF #
51200		MOVEM 2,Q+5(1)		;PN(J+6)=CLEF
51300		JRST PN3
51400	PN1:	MOVEM 6,XXX	;LK=LK+1		(6666↑)
51500		MOVE 4,LLL     	;  -L-  XWDS(L)=LK
51600		ADDI 4,@1(16)	; ADDR. XWDS ARRAY
51700		MOVEM 6,(4)
51800		AOS LLL        ;L=L+1
51900		JRA 16,3(16)
52000	SORT:	0		; CALL SORT(XWDS)
52100		MOVE 11,LLL   	; L
52200		SOJ 11,
52300		MOVEI 4,1		;I=1
52400		MOVE 0,[16.0]
52500		MOVE 1,[8.0]
52600		SETZ 5,		; -K-  DO 243 K=1,L-1
52700	S2:	MOVEI 7,@(16)	; ADDR. OF XWDS
52800		ADDI 7,(5)			;LB=XWDS(K)+1
52900		MOVE 6,(7)
53000	;;	MOVE 10,Q(6)		;IF(PN(LB).NE.16)GO TO 243
53100	;;	CAME 10,[16.0]
53200		CAME 0,Q(6)
53300		JRST S243
53400	;;	MOVE 10,Q-1(6)		;IF(PN(LB-1).LT.8)GO TO 243
53500	;;	CAMGE 10,[8.0]
53600		CAMLE 1,Q-1(6)
53700	
53800		JRST S243
53900		MOVE 10,-1(7)		;JL=XWDS(K-1)
54000		MOVE 10,Q+2(10)
54100		MOVEM 10,Q+2(6)	;244	PN(LB+2)=PN(JL+3)
54200	S243:	AOJ 5,
54300		CAME 5,11		; -L-1
54400		JRST S2			; 243    CONTINUE
54500	
54600	;; PUTS CONTINUATION OF TEXT IMMEDIATELY AFTER PREV. POS.
54700	;;  FOR SPACING PROBLEMS BELOW.
54800		MOVEI 11,1		;M=2
54900		SETZ 12,		;J=1
55000	S24:	MOVE 13,[100000.0]	;24	RA=100000.;; POSITION
55100		MOVE 1,LLL   		; L
55200		SOJ 1,
55300		SETZ 14,		; -K-
55400	S21:	MOVEI 2,@(16)		;DO 21 K=1,L-1  - ADDR. OF XWDS -
55500		ADDI 2,(14)		;JL=XWDS(K)+3
55600		MOVE 2,(2)
55700		MOVE 3,Q+2(2)		;R=PN(JL)
55800		CAMN 3,[100000.0]
55900		JRST SX21		;IF(R.EQ.100000)GO TO 21
56000		MOVE 3		;241	IF(ABS(R-RA).GT..1)GO TO 240
56100		FSBR 13
56200		SKIPGE
56300		MOVNS
56400		CAMLE 0,[0.1]
56500		JRST S240
56600		MOVEM 13,Q+2(2)	; ((R=RA))	PN(JL)=R
56700		JRST SX21	;GO TO 21;; PUT IN HERE MULTI-VOICE TRAP SOMEDAY
56800	S240:	CAMLE 3,13		;240	IF(R.GT.RA)GO TO 21
56900		JRST SX21    ;; LINES THEM UP
57000		MOVEI 4,(2)		;	SAVES JL (I=K)
57100		MOVE 13,3  ; RA=R		;21	CONTINUE
57200	SX21:	AOJ 14,		; -K-¬
57300		CAME 14,1
57400		JRST S21
57500		CAMN 13,[100000.0]	;IF(RA.EQ.100000)GO TO 23
57600		JRA 16,1(16);  JUMP IF ALL SORTED
57700	;;;;	MOVE 10,(16)		;242	JL=XWDS(I)
57800		MOVEI 15,(4)		;LA=JL
57900		KIFIX 1,Q-1(4)		;N=PN(JL)+3
58000		ADDI 1,3		; N
58100		MOVE 2,PTR-1(11)	; PWDS(M)=PWDS(M-1)+N
58200		ADDI 2,(1)
58300		MOVEM 2,PTR(11)
58400		AOJ 11,		;	M=M+1
58500	;;	FIXX(1)			;DO 22 K=J,J+N-1
58600		ADDI 1,(12)		; -J+N-
58700	S22:	MOVE 2,Q-1(4)		;	RN(K)=PN(JL)
58800		MOVEM 2,XRN(12)
58900		AOJ 12,
59000		CAME 12,1
59100		AOJA 4,S22		;22   JL=JL+1
59200		AOJ 4,			; (JL=JL+1)
59300		MOVE 2,[100000.0]	;  PN(LA+3)=100000
59400		MOVEM 2,Q+2(15)		; PUT IT ASIDE
59500		JRST S24	;  	GO TO 24
59600	
59700	SHIFT:	0		; CALL SHIFT
59800		SOS LLL		; (IN MAIN.  L=L-1)
59900		SETZ 2,		;K=1
60000		SETZ 3,		;L=1
60100		SETO 4,		;LK=1  ((LL=0))
60200	SH221:	MOVE 5,PX(2)	;221	IF(Q(IFIX(PN(K))+1))GO TO 321
60300		MOVE 6,Q(5)
60400		JUMPL 6,SH321
60500		MOVE 7,PX+1(2)
60600	SH421:	MOVE 6,Q-1(5)		;DO 421	 KL=IFIX(PN(K)),IFIX(PN(K+1))-1
60700		MOVEM 6,Q(3)	; ((LL=LL+1))421	Q(LL)=Q(KL)
60800		AOJ 5,
60900		CAMGE 5,7
61000		AOJA 3,SH421
61100		AOJ 4,		;LK=LK+1
61200		AOJ 3,
61300		MOVE 1,3		;PN(LK)=LL+1
61400		AOJ 1,
61500		MOVEM 1,PX+1(4)
61600	SH321:	AOJ 2,			;321	K=K+1
61700		CAMGE 2,LLL   	; (L) IF(K.LT.KK)GO TO 221
61800		JRST SH221
61900		AOJ 4,
62000	 	MOVEM 4,LLL   	; L=LK-1  ;; L=NUMBER OF ITEMS FOR RHY RECONS.
62100		JRA 16,(16)
62200	
62300	SHFT1:	0		; CALL SHFT1(KQ)
62400		MOVEI 2,1		; -L-  (KK=1)
62500		MOVEI 6,1		; -K-
62600	SP:	KIFIX 4,Q-1(6)		;220	JJ=Q(K)+3
62700		ADDI 4,3
62800		MOVEM 6,PX-1(2)
62900	;;NEW POINTER
63000		MOVE Q(6)	;IF(Q(K+1).NE.2.OR.Q(K).LT.6)GO TO SPA
63100		CAME [2.0]
63200		JRST SPA
63300		MOVE [6.0]
63400		CAMLE Q-1(6)
63500		JRST SPA
63600		MOVEI 13,(4)	; JJ
63700		ADDI 13,(6)	; +K
63800		MOVE 3,Q(13)	;IF(Q(JJ+1).NE.10.OR.Q(JJ).LT.6)GO TO SPA
63900		CAMN 3,[10.0]
64000		CAMLE Q-1(13)
64100		JRST SPA
64200	
64300		SKIPN IPG		;IF(IPG.EQ.0)GO TO SPA
64400		JRST SPA	;do next only when extracting parts(IPG.NE.0)
64500		SETO 3,		;M=0 (-1)
64600		KIFIX 5,Q-1(13)	; KK=Q(JJ)+2
64700		        	;DO SPB N=K,KK
64800		ADDI 5,2	; KK
64900		MOVEI 7,(6)	; (N=K)
65000		ADDI 5,(7)	; (KK=K+KK+JJ-1)
65100		ADDI 5,(4)
65200	;;	SOJ 5,		; THE TOTAL NUM OF ITEMS TO SCRAMBLE
65300	SPB:	MOVE Q-1(7)	;M=M+1
65400		AOJ 3,		;  M
65500		MOVEM XRN(3)	;SPB	RN(M)=Q(N)
65600		CAIGE 7,(5)
65700		AOJA 7,SPB
65800	
65900		MOVEI 3,(13)	; JJ
66000		SUB 3,6		; M=JJ-K  (-1)
66100		MOVEI 7,(5)	; KK
66200		SUB 7,13		; J=KK-JJ
66300		MOVEI 11,(7)	; KA=J
66400		ADDI 11,(6)	; +K
66500	;;	SOJ 11,		;KA=K+J-1
66600		MOVEI 12,(6)	; N=K
66700		MOVEI 14,(12)
66800		MOVE 15,XRN+3(3)	; SAVE POS (R3)
66900	SPC:	MOVE XRN(3)	;DO SPB N=K,KA
67000		MOVEM Q-1(12)	; M=M+1
67100		AOJ 3,		;SPC	Q(N)=RN(M)
67200		CAIGE 12,(11)
67300		AOJA 12,SPC
67400	
67500		MOVEI 13,(6)	; JJ=K+J
67600		ADDI 13,(7)	; JJ
67700		SETZ 3,		; M=0 
67800		SOJ 5,		; KK-1
67900		MOVE 7,XRN+3(3)	; POS OF THIS ITEM
68000		MOVEM 7,Q+2(14)	;EXCHANGE THEM
68100		MOVEM 15,XRN+3(3)
68200	SPD:	MOVE XRN(3)	;DO SPD N=JJ,KK-1
68300		MOVEM Q(13)	; M=M+1
68400		AOJ 3,		;SPD	Q(N)=RN(M)
68500		CAIGE 13,(5)
68600		AOJA 13,SPD	; ALL THIS TO FIND NUM AFTER WHOLE REST.
68700		JRST SP		;GO BACK TO GET RIGHT PNTRS NOW.
68800				;K=K+JJ
68900	SPA:	ADDI 6,(4)	; -K- (KK=KK+1)
69000		CAMGE 6,@(16)		;IF(K.LT.KQ)GO TO 220
69100	 	AOJA 2,SP
69200		AOJ 2,      		;PN(KK)=K
69300		MOVEM 6,PX-1(2)
69400		MOVEM 2,LLL       ;L=KK
69500		JRA 16,1(16)
69600	
69700	
69800	SHFT0:	0		; CALL SHFT0(KQ)
69900		MOVE 2,LLL   		;  L
70000		MOVE 4,PTR-1(2)
70100		SOJ 4,
70200		MOVE 2,@(16)		;  KQ
70300	;;	SETZ 3,			; K
70400	;;SH32:	MOVE XRN(3)	; DO 32 K=1,IFIX(PWDS(L))-1
70500	;;	MOVEM Q(2)	; KQ=KQ+1
70600	;;	AOJ 3,
70700	;;	CAME 3,4
70800	;;	AOJA 2,SH32
70900	;;	AOJ 2,		; 32  Q(KQ)=RN(K)
71000		HRLZI 3,XRN	; PUT ADDR OF RN IN LEFT HALF
71100		HRRI 3,Q(2)	; ADDR OF NEXT OPEN SLOT OF Q IN RIGHT HALF
71200		ADDI 2,(4)	; TO LOCATE END OF TRANSFER
71300		BLT 3,Q(2)	; THESE REPLACE THE ';;' ABOVE
71400		MOVEM 2,@(16)		; NEW VALUE OF KQ
71500		MOVEI 1
71600		MOVEM LLL   		; L
71700		MOVEM XXX		; LK
71800		JRA 16,1(16)
71900	
72000	PSHFT:	0		; CALL PSHFT(I)
72100		MOVE 6,@(16)
72200		MOVEI 2,1
72300		MOVE 2,PX-1(2)	;	DO 31 NA=1,I
72400		MOVE 3,PX(6)	;	RN(KL)=Q(NA)
72500				; 31	KL=KL+1
72600		MOVE 4,SF		; KL
72700	PS31:	MOVE 5,Q-1(2)
72800		MOVEM 5,XRN-1(4)
72900		AOJ 2,
73000		CAIE 2,(3)
73100		AOJA 4,PS31
73200		AOJ 4,
73300		MOVEM 4,SF		;  PUT BACK NEW VALUE OF KL
73400		JRA 16,1(16)
73500	
73600	;	SUBROUTINE ADDRST(RPOS,XWDS,PN)
73700	;	COMMON /XXX/LK,LP,JY /PTR/PWDS(250),L,LL,I,IX
73800	;	COMMON RS,JA,REST,J2,RQ(18),JX,JR,LX,RDIS
73900	;	DIMENSION XWDS(1),PN(1)
74000	
74100	ADRST:	0		;	PN(LK)=6
74200		MOVE 1,XXX		; LK
74300		MOVE 6,[6.0]		;      CALL ADRST(XWDS,RR)
74400		MOVEM 6,Q-1(1)
74500		MOVE 2,[2.0]	;	PN(LK+1)=2
74600		MOVEM 2,Q(1)
74700	;;	MOVE 13,.COMM.		;	PN(LK+2)=RS
74800		SETZM Q+1(1)
74900		MOVE 3,DBX  		;	PN(LK+3)=RPOS-1.  (DBX SAVED 'RR')
75000		MOVEM 3,Q+=11(1)	;  SEE (LK+3) BELOW
75100		FSBR 3,[1.0]
75200		MOVEM 3,Q+2(1)
75300		SETZM Q+3(1)		;	PN(LK+4)=0   
75400		SETZM Q+4(1)		;	PN(LK+5)=0   
75500		SETZM Q+5(1)		;	PN(LK+6)=0   
75600		MOVEM 6,Q+6(1)		;	PN(LK+7)=6.  
75700		MOVE 10,[1.0];	PN(LK+8)=-1
75800		MOVNM 10,Q+7(1)
75900	;	LK=LK+9
76000	;	L=L+1
76100	;	XWDS(L)=LK
76200	; NEXT ADDS A BAR LINE
76300		MOVEM 2,Q+=8(1)	;	PN(LK)=2
76400		MOVE [4.0]		;	PN(LK+1)=4
76500		MOVEM Q+=9(1)
76600	;;	MOVEM 13,PX+=10(1)	;	PN(LK+2)=RS
76700		SETZM Q+=10(1)
76800	;	PN(LK+3)=RPOS		(SEE ABOVE)
76900		MOVE 10,@1(16)		;GET BAR LINE INFO
77000		MOVEM 10,Q+=12(1)	;	PN(LK+4)=RR
77100	;	LK=LK+5
77200	;	L=L+1
77300	;	XWDS(L)=LK
77400	;	END
77500		MOVE 2,LLL   		; L
77600		HRRZI 3,@(16)		; ADDR OF XWDS
77700		ADDI 3,(2)
77800		ADDI 1,=9
77900		MOVE 4,1
78000		MOVEM 4,(3)		;XWDS(L)=LK
78100		ADDI 4,5
78200		MOVEM 4,1(3)		;XWDS(L+1)=LK
78300		ADDI 2,2
78400		MOVEM 2,LLL   	;L=L+2
78500		ADDI 1,5
78600		MOVEM 1,XXX		;LK=LK+14
78700		JRA 16,2(16)
78800	
78900	STAFF:	0    ;	SUBROUTINE STAFF(P0,P1, P3,P4,P5,P6,P7,P8)
79000	;;	COMMON/XRN/RN(2000) /SF/KL,RT,KP,RSTJ2,NAMX
79100	;;	COMMON /PTR/PWDS(250),L,LL,I,IX
79200		MOVE 2,SF+2	; KP	PWDS(KP)=KL
79300		MOVE 4,SF	; KL
79400		MOVEI 3,(4)
79500		MOVEM 3,PTR-1(2)
79600		AOJ 2,		;	KP=KP+1
79700		MOVEM 2,SF+2
79800		MOVE 2,@(16)	;  RN(KL)=P0
79900		MOVEM 2,XRN-1(4)
80000		MOVE @1(16)	;  RN(KL+1)=P1
80100		MOVEM XRN(4)
80200		MOVE SF+1	;  RN(KL+2)=RT
80300		MOVEM XRN+1(4)
80400		MOVE @2(16)	;  RN(KL+3)=P3
80500		MOVEM XRN+2(4)
80600		MOVE @3(16)	;  RN(KL+4)=P4
80700		MOVEM XRN+3(4)
80800		MOVE @4(16)	;  RN(KL+5)=P5
80900		MOVEM XRN+4(4)
81000		CAMGE 2,[4.0]	;  IF(P0.LT.4.)GO TO 1
81100		JRST ST1
81200		MOVE @5(16)	;  RN(KL+6)=P6
81300		MOVEM XRN+5(4)
81400		MOVE @6(16)	;  RN(KL+7)=P7
81500		MOVEM XRN+6(4)
81600		MOVE @7(16)	;  RN(KL+8)=P8
81700		MOVEM XRN+7(4)
81800		MOVE @=8(16)	;  RN(KL+9)=P9
81900		MOVEM XRN+=8(4)
82000		MOVE @=9(16)	;  RN(KL+10)=P10
82100		MOVEM XRN+=9(4)
82200		MOVE @=10(16)	;  RN(KL+11)=P11
82300		MOVEM XRN+=10(4)
82400		MOVE @=11(16)	;  RN(KL+12)=P12
82500		MOVEM XRN+=11(4)
82600	ST1:	KIFIX 2,2 	;1	KL=KL+P0+3.
82700		ADDI 2,3
82800		ADDM 2,SF
82900		JRA 16,=12(16)		; END
83000	
83100	;;;RIGHT:	0	;	FUNCTION RIGHT(NA,J)
83200	;;	COMMON /PX/PN(1800) /Q/Q(9000)
83300	;;;	MOVE 4,@(16)		;  NA  K=NA+J
83400	;;;	ADD 4,@1(16)		; +J     J IS EITHER +1 OR -1
83500	;;;	MOVE 5,[16.0]
83600	;;;RT1:	MOVE 3,PX-1(4)		; 1	L=PN(K)
83700	;;	MOVE Q(3)		; IF(Q(L+1).NE.16)GO TO 2
83800	;;	CAME [16.0]		; **** CAN'T USE AC2 - USED IN FORTRAN
83900	;;;	CAME 5,Q(3)
84000	;;;	JRST RT2
84100	;;;	ADD 4,@1(16)		; K=K+J
84200	;;;	JRST RT1		; GO TO 1
84300	;;;RT2:	MOVE Q+2(3)		; 2	RIGHT=Q(L+3)
84400	;;;	JRA 16,2(16)		; END
84500	RIGHT:	0		;FUNCTION RIGHT(NA,J,JK)
84600		MOVE 4,@(16)
84700		MOVE 6,4
84800		MOVE 11,@1(16)	; SAVE J IN 11
84900		ADD 4,11	;  K=NA+J      J= +1 OR -1
85000		SKIPLE 4	; IF(K.GT.0)GO TO RT4
85100		JRST RT4
85200		MOVE 0,Q+3	;RIGHT=Q(JK+3)
85300		JRA 16,3(16)	;RETURN
85400	RT4:	MOVEI 5,Q	; Q	R=Q(JK+2)
85500		ADD 5,@2(16)
85600		MOVE 12,2(5)	; RX=Q(JK+3)-2   CURRENT POS. OF REST-2
85700	;;;	FSBR 12,[2.0]	; NEEDED IF NOTHING FOUND TO LEFT.
85800		MOVE 5,1(5)	;R  THE STAFF NUM.
85900		MOVEI 8,1	;JX=1       FOR REVERSE LOOP
86000		SKIPL @1(16)	;IF(J.GT.0)JX=I    FORWARD LOOP
86100		MOVE 8,LLL+2
86200	RT1:	JSA 16,CODEN	;	DO 134 K=NA-1,1,-1
86300		JUMP PX		;	R8=CODEN(KPN,K,Q,LL)
86400		JUMP 4
86500		JUMP Q
86600		JUMP 7		;LL
86700		CAMN 0,[4.0]	;	IF(R8.EQ.4)GO TO 234
86800		JRST RT2
86900	  	MOVE 3,Q+1(7)	;	IF(Q(LL+2).NE.R)GO TO 134
87000	  	CAME 3,5
87100	  	JRST RT3
87200		CAME 0,[18.0]	;  	IF(R8.EQ.18.OR.R8.EQ.17)GO TO 234
87300		CAMN 0,[17.0]	;	JUMP ON KEY SIG OR METER
87400		JRST RT2
87500	;;	CAML 0,[10.0]	;	IF(R8.GE.10)GO TO 134
87600	;;	JRST RT3
87700	;;	CAME 0,[3.0]	;	IF(R8.NE.3)GO TO 234
87800	;;	JRST RT2
87900	RT3:	CAMN 4,8	;134 	CONTINUE
88000		JRST .+3
88100		ADD 4,11
88200		JRST RT1
88300		SKIPG 11	;SKIP NEXT IF GOING FORWARD IN LOOP (LOOKING TO RIGHT)
88400		MOVE 0,12	;USE ITS OWN POS.-2 IF NOTHING FOUND TO LEFT
88500		SKIPA		;	RR=RX
88600	RT2:	MOVE 0,Q+2(7)	;	C NOW FOUND ITEM TO LEFT OR RT ON THIS STAFF.
88700		JRA 16,3(16)	;234	RR=Q(LL+3)
88800	
88900	RESTS:	0		;XLFT=0  -- CALL RESTS
89000		SETZ 2,
89100		MOVE 12,[4.0]
89200	
89300		MOVE 13,[16.0]	; TO CATCH WORDS
89400		MOVN 3,[99.0]		;SIG=-99
89500	;;	MOVE 4,3		;CLEF=-99
89600		SETZ 6,		;	REST=0
89700		MOVEI 7,1		;K=1
89800	RX50:	MOVE 10,PX-1(7)		;50	JL=PN(K)
89900		MOVE 11,Q(10)		;R=Q(JL+1)
90000		JUMPN 2,RX5		;IF(XLFT.NE.0)GO TO 5
90100		CAMLE 11,[4.0]		;IF(R.LE.4)XLFT=Q(JL+3)
90200		JRST RX5
90300		MOVE 2,Q+2(10)
90400		MOVEM 2,.COMM.+=13
90500		JRST RX3
90600	RX5:	CAME 11,[17.0]		;5	IF(R.NE.17)GO TO 3
90700		JRST RX3
90800		MOVE 1,Q+4(10)		;IF(Q(JL+5).EQ.SIG)GO TO 60
90900		CAMN 1,3
91000		JRST RX60
91100		MOVE 3,1		;SIG=Q(JL+5)
91200	RX3:	CAME 11,[2.0]		;3	IF(R.NE.2)GO TO 231
91300		JRST RX231
91400		MOVE Q-1(10)		;IF(Q(JL).GE.6)GO TO 7
91500		CAML [6.0]
91600		JRST RX7
91700	
91800		JRST RX231	;NEXT (TO RX7) DOESN'T WORK YET.  NEEDS TO EXPND DATA!
91900	;;	MOVE 1,PX-2(7)		;IF(Q(KPN(K-1))+1).NE.4)GO TO 231
92000	;;	CAMN 12,Q(1)
92100	;;	JRST RX55     ; ANY REST BETWEEN 2 BARS IS A "WHOLE" REST.
92200	;;	CAME 13,Q(1)
92300	;;	JRST RX231	; IF NOT WORDS, JUMP
92400	;;	MOVE 14,PX-3(7)
92500	;;	CAME 12,Q(14)	; IS THIS ONE A BAR?
92600	;;	JRST RX231	; NO
92700	; WON'T CATCH IT IF THERE IS A CLEF, METER, ETC. PRESENT
92800	;;RX55:	MOVE 1,PX(7)		;IF(Q(KPN(K+1))+1).NE.4)GO TO 231
92900	;;	CAME 12,Q(1)
93000	;;	JRST RX231
93100	; FOUND A WHOLE REST MEAS.
93200	
93300	;;RX8:	MOVE 11,[3.0]	;Q(JR)=3  (P7=3)
93400	;;	MOVE 13,PX-1(7)	;JR=JL+7
93500	;;	ADDI 13,6
93600	;;	CAMLE 12,Q(13)	;IF(Q(JR+1).GT.4)GO TO RX9
93700	;;	JRST RX9
93800	;;	MOVNM 11,Q-3(13)	;Q(JR-2)=-3  P5=-3 =DBL WHOLE REST
93900	;;	MOVE [8.0]	;IF(R.LT.8)GO TO RX9
94000	;;	CAMGE Q(13)
94100	;;	JRST RX9
94200	;;	MOVE 11,Q(13)	;Q(JR-1)=IFIX(R/4.0)+2.0
94300	;;	FDVR 11,12
94400	;;	KIFIX 11,11
94500	;;	FLTR 11,11
94600	;;	FADR 11,[2.0]
94700	;;RX9:	MOVEM 11,Q(13)
94800	;;	JRA 16,(16)	;RETURN
94900	
95000	RX7:	MOVN Q+7(10)	;IF(Q(JL+8).LE.-4)GO TO 231
95100		SKIPLE Q+6(10)	;IF(Q(JL+7).LE.0)GO TO 231 (IGNORE NON-RHYTH.)
95200		CAML [4.0]	;CATCH BAR REPEAT SIGN
95300		JRST RX231
95400		JUMPE RX231	;IF(Q(JL+8).EQ.0)GO TO 231 (WHOLE REST OVER CUE NOTES)
95500		JUMPN 6,RX6		;7	IF(REST.NE.0)GO TO 6
95600		MOVEI 13,(10)		;JR=JL+8
95700		ADDI 13,6
95800	;  POINTER TO REST NUM.
95900		MOVE 11,Q(13)		;R=Q(JR-1)
96000		CAMGE 11,[5.0]		;IF(R.LT.5)R=5
96100		MOVE 11,[5.0]
96200		FMPR 11,[0.6]		;Q(JR-1)=R*.6
96300		MOVEM 11,Q(13)
96400	;  REDUCE SIZE OF REST'S TIME SO IT WILL TAKE LESS SPACE.
96500	RX6:	FADR 6,[1.0]		;6	REST=REST+1
96600		MOVEM 6,Q+1(13)		;Q(JR)=REST
96700		MOVN [2.0]
96800		MOVEM Q-3(13)		;Q(JR-4)=-2  (LOWER THE REST'S POS.)
96900		MOVEI 10,(7)		;JL=K+2
97000		ADDI 10,2
97100		CAML 10,LLL		;IF(JL.GE.L)RETURN
97200		JRA 16,(16)
97300	;;;	JRST RX8
97400		MOVE 14,PX-1(10)	;LB=KPN(JL)
97500		MOVE Q(14)		;IF(Q(LB+1).NE.2)GO TO 233
97600		CAME [2.0]
97700		JRST RX233	; NEXT IS TO COMBINE MEASURES OF REST
97800		MOVE Q-1(14)		;IF(Q(LB).LT.6)GO TO 233
97900		CAMGE [6.0]
98000		JRST RX233
98100	;  SKIP NON-WHOLE RESTS
98200		MOVE 15,PX-2(10)	;N=KPN(JL-1)
98300	;;	MOVE Q(15)		;IF(Q(N+1).NE.4)GO TO 233
98400		CAME 12,Q(15)
98500		JRST RX233
98600	;  IS REST FOLLOWED BY A BAR?	OR RHRSL NUM?(COULD BE A PROB. HERE!!!)
98700	; SO IT WON'T BE FOUND NEXT TIME AROUND.
98800		MOVN	[1.0]		;Q(LB+1)=-1
98900		MOVEM Q(14)    ;  CHANGE CODE #
99000		MOVEM Q(15)		;Q(N+1)=-1 
99100		MOVEI 7,(10)		;K=JL
99200		JRST RX6		;GO TO 6
99300	RX60:	MOVE [1.0]		;60	Q(JL+1)=-1
99400		MOVNM Q(10)
99500		JRST RX231		;GO TO 231
99600	RX233:	SETZ 6,			;233	REST=0
99700	RX231:	AOJ 7,			;231	K=K+1
99800		CAMGE 7,LLL		;IF(K.LT.L)GO TO 50
99900		JRST RX50
     

00100		JRA 16,(16)		; END
00200	
     

00100	EXCHG:	0		;CALL EXCHG(MM(J),NN(J))
00200		HRRZI 1,@(16)	; ADDR OF MM(J)
00300		MOVE 2,1(1)	;VALUE OF MM(J+1)
00400		EXCH 2,@(16)	;EXCHANGE
00500		MOVEM 2,1(1)	; MM(J+1)
00600		HRRZI 1,@1(16)	; ADDR OF NN(J)
00700		MOVE 2,1(1)	;VALUE OF NN(J+1)
00800		EXCH 2,@1(16)	;EXCHANGE
00900		MOVEM 2,1(1)	; NN(J+1)
01000		JRA 16,2(16)
01100	
01200	EXCH:	0
01300		MOVE @(16)
01400		EXCH @1(16)
01500		MOVEM @(16)
01600		JRA 16,2(16)
01700	
01800	INMUS:	0		;CALL INMUS(NAME,EXT,RN,KWDS,RSTFAC)
01850		MOVE 1,@(16)
01900		MOVE 2,@1(16)
02000		JSA 16,GETEXT  	
02100		JUMP 1    	;NAME
02200		JUMP 2 		;EXT
02300		MOVE 11,4(16)	;LOC OF RSTFAC ARRAY
02400		MOVE 12,3(16)	;LOC OF KWDS ARRAY
02500		JSA 16,EXTIN  	;ACCEPT 2,NAM
02600	 	JUMP @11	;	CALL GETEXT(NAM,'MS')
02700		JUMP [=20]	;READ ONLY 20 WDS IN PAGE ONLY****** NOT [=128]  
02800		MOVE 15,2(16)	;LOC OF RN ARRAY
02900	I1:	JSA 16,EXTIN  	;CALL EXTIN(R,JJ)
03000		JUMP @15	;JUMP @R
03100		JUMP =18(11)	;WDS    	;THE WD CNT.
03200		MOVE @15	;@R		;IF(R(1).NE.INTEGER 1)GO TO I3
03300		CAIE 1		;OLD FORMAT ?
03400		JRST I3		;NO
03500		USETI 12,2	;YES, READ 2ND RECORD AGAIN   (12 =CH)
03600		JSA 16,EXTIN  	;CALL EXTIN(RS,128)
03700		JUMP @12	;JUMP @KW
03800		JUMP =17(11)	;JUMP NWDS    	;CALL EXTIN(K,J)
03900		JRST I1		;GO BACK AND GET R ARRAY
04000	I3:	MOVEI 1,1  	;3	N=1     ;KK(NN)=N
04100		MOVEM 1,(12)	;K(1)=1  	
04200		MOVEI 5,1
04300	I4:	ADD 15,5  	;4	N=N+R(N)+3       HERE'S THE LOOP 
04400		KIFIX 5,-1(15)  ;GET WD CNT -2
04500	;;	SKIPG 5		;LEAVE IF NUM. IS .LE.0
04600	;;	JRA 16,5(16)
04700	I5:	ADDI 5,3   	;NN=NN+1
04800		ADD 1,5
04900		AOJ 12,      		;UPDATE THE COUNTER OF THE POINTER LIST
05000		MOVEM 1,(12)         	;KK(NN)=N
05100		CAMGE 1,=18(11)         ;IF(N.LT.JJ)GO TO 4
05200		JRST I4
05300		JRA 16,5(16)
     

00100	RCURVE:	0	;   R7=RCURVE(R3)
00200		MOVEI 2,@(16)	;	R7=2.0+(R6-R3)/25.+ABS(R4-R5)/10.
00300		MOVE 1,3(2)
00400		FSBR 1,(2)		;R6-R3
00500		MOVE 3,5(2)		;IF(R8.LT.-1)Z=Z+R8*2.
00600		FADR 3,[1.0]
00700		JUMPGE 3,RCRV		;R8=-2=BETWEEN NOTES, =-3=1ST NOTE IS DOTTED.
00800		FADR 3,3    
00900		FADR 1,3
01000	RCRV:	FDVR 1,[25.0]		; /25.
01100		MOVE 0,2(2)
01200		FSBR 0,1(2)		;R5-R4
01300		MOVMS			;ABSOLUTE VALUE
01400		FDVR 0,[10.0]		; /10.
01500		FADR 0,1
01600		FADR 0,[2.0]		; +2.0   (THIS IS + .9 IN MS)
01700		SKIPGE 4(2)		;IF(R7 WAS .LT.0)KEEP IT NEGATIVE.
01800		MOVNS
01900		JRA 16,1(16)
02000	
02100	SHRNK:	0		;CALL SHRNK(K,IT)
02200		MOVE 10,@1(16)
02300		MOVE 11,PX(10)	;END OF Q DATA
02400		SOJ 10,
02500		MOVE 2,@(16)	;K
02600		MOVEI 12,(2)
02700		MOVE 3,PX-1(2)	;PTR TO Q(n)
02800		MOVEI 6,(3)	;SAME
02900		MOVE 13,Q+2(3)	;POS. OF CLEF TO BE REMOVED.
03000		MOVE 4,PX(2)	;PTR TO NEXT ITEM
03100		MOVEI 1,(4)	;TO USE IN BLT
03200		SUBI 3,(4)	;WDCCNT OF DELETE ITEM
03300		SUB 4,PX+1(2)	; NEXT +1
03400		SUB 3,4		; AMOUNT OF CHANGE
03500	SK:	MOVE 5,PX+1(2)
03600		SUB 5,PX(2)
03700		ADD 5,PX-1(2)
03800		MOVEM 5,PX(2)
03900		CAIE 2,(10)
04000		AOJA 2,SK
04100		MOVE 2,PX(2)	; LAST PTR
04200		MOVE 7,Q+2(6)	;POS FOR LATER "MOVE"
04300	SK2:	MOVE Q-1(1)
04400		MOVEM Q-1(6)
04500		AOJ 1,
04600		CAIE 1,(11)
04700		AOJA 6,SK2
04800		MOVEM 10,@1(16)
04900		MOVEM 10,LLL+2	;I=LEND (FOR FINAL ENDPOINT)
05000	;;	AOJ 10,		; TO GET TO END OF DATA.
05100		MOVEM 7,.COMM.+5	;R4
05200	SKMV:	SETZM LLL+1	;LL=0 (NO JUSTIFY)
05300		MOVE 2,[200.0]
05400		MOVEM 2,.COMM.+6	;R5
05500		SETZM .COMM.		;RS
05600		MOVEM 2,.COMM.+=10	;R9=R5
05700		SETZM .COMM.+=8		;R7
05800		MOVEM 13,.COMM.+=9	;R8=EXPAND REMAINDER OF LINE TO CLEF POS.
05900		JSA 16,PTMOVE
06000		JUMP Q
06100		JUMP PX-1(12)
06200		JRA 16,2(16)
06300	
06400	EXPND:	0	; TO SHIFT LINE TO RT. WHEN ADDING KSIG.
06500		MOVE 5,[5.0]
06600		MOVE 2,[7.1]
06700		FMPR 2,STF+=8
06800		MOVEM 2,.COMM.+5	;R4=7*RSTJ2+.1
06900		MOVE 12,@(16)	; GET PTR TO PX
07000		ADDI 12,2	; ADD 2 (FOR NOW, ANYWAY)
07100		SETZM .COMM.+=9
07200		JRST SKMV	; GO MOVE IT
07300	
07400	CLFNUM:	0	;X=CLFNUM(Q,PX,MS)  (FUNCTION)
07500		MOVEI 2,@1(16)	;GET PX'S ADDR
07600		ADD 2,@2(16)
07700		MOVE 2,(2)	;PX(MS)
07800		MOVEI 1,@(16)	; ADDR OF Q
07900		ADD 2,1		;ADDR OF Q(PX(MS)+1)
08000		MOVE 5(2)	;X=Q(PX(MS)+5)
08100		MOVE 1,-1(2)
08200		CAMGE 1,[3.0]	;IF (Q( ).LT.3)X=0
08300		SETZ		; ANSWER IN AC0
08400		JRA 16,3(16)
08500	
08600	SLRV:	0		; CALL SLRV(KK,C)
08700		MOVE 1,@(16)	; KK
08800		MOVE 2,@1(16)	; C
08900		FADRM 2,Q+3(1)	; WORKS WITH Q ARRAY ONLY******
09000		FADRM 2,Q+4(1)	; FOR Q(KK+4) AND (KK+5)
09100		MOVNS Q+6(1)	; Q(KK+7)
09200		JRA 16,2(16)
09300	
09400	CLEFN:	0
09500		MOVEI 3,@(16)		;FUNCTION CLEFN(Q,J)
09600		ADD 3,@1(16)	;Q(J+1) NOW
09700		MOVE 2,-1(3)		;IF(Q(J).LT.3)RR=0
09800		SETZ 0,
09900		CAML 2,[3.0]
10000		MOVE 0,4(3)
10100		JRA 16,2(16)
10200	;	CAMGE 0,[100.0]
10300	;	JRA 16,2(16)		;IF(Q(J+5).LT.100)RR=Q(J+5)
10400	;	JSA 16,AMOD
10500	;	JUMP 4(3)		;ELSE RR=AMOD(Q(J+5),100.0)
10600	
10700	MMNN:	0			;CALL MMNN(K)
10800		MOVEI 2,1		;N=N+1
10900		ADDB 2,JN+1		;NN(N)=0
11000	;;;;	SETZM XRN+=499(2)
11100		MOVE @(16)		
11200		CAIE 0,3		;IF(K.NE.3)NN(N)=-1   FOR SECONDARY POSITIONS.
11300		SETOM XRN+=499(2)
11400		ADD JN			;MM(N)=J+K
11500		MOVEM XRN-1(2)
11600		JRA 16,1(16)
11700	
11800	CODEN:	0		;FUNCTION CODEN(K,N,R,M)
11900		MOVE 1,@1(16)	;PNTR TO K ARRAY
12000		SOJ 1,
12100		ADDI 1,@(16)	;ADD LOC OF K ARRAY
12200		MOVE 1,(1)	;GET PNTR TO R ARRAY
12300		MOVEM 1,@3(16)	;SEND IT BACK IN M
12400		ADDI 1,@2(16)	;ADD LOC OF R ARRAY
12500		MOVE (1)	;R(M+1)  (CODE NUM OF ITEM)
12600		JRA 16,4(16)
12700		
12800	ZERO:	0  		;FUNCTION ZERO(X,Y)
12900		MOVE @(16)	;ZERO=X-Y
13000		FSBR @1(16)
13100		SKIPGE    	;IF(ABS(ZERO).LT..01)ZERO=0
13200		MOVNS
13300		CAMG 0,[0.01]
13400		SETZ 0,
13500		JRA 16,2(16)	;END
13600	
13700	; DO NEXT IF MORE THAN 1 STAFF(KPG) AND DIFF. SIZE FACTORS ARE FOUND.
13800	BARFAC:	0		;CALL BARFAC(KPG,BFAC,JK)  R=RSTFAC(1)
13900		MOVE 10,STF	;   DO 5112 K=2,KPG
14000		MOVEI 2,1
14100	BA:	CAME 10,STF(2)	;5112	   IF(R.NE.RSTFAC(K))GO TO 6112
14200		JRST BB
14300		AOJ 2,	
14400		CAML 2,@(16)
14500		JRA 16,3(16)	;  GO TO 3112 -- RETURN
14600		JRST BA
14700	; NEXT TO FIND PROBABLE SIZE FACTOR FOR THIS BAR. (NOT FOR PARTS)
14800	;  FIND LINE WITH MOST ACTIVITY.
14900	;  ALL THIS SORT OF WORKS.  SOMEDAY REVIEW IT.********
15000	BB:	MOVEI 2,7	;6112	   DO 1112 K=1,8
15100	BC:	SETZM XRN(2)
15200		SOJGE 2,BC	;1112	   RN(K)=0
15300		MOVE 2,@2(16)	;   DO 112 K=JK,J-1
15400		MOVE 7,[7.0]
15500	;;	MOVE 5,[5.0];;;;; WE COUNT ALL RESTS, EVEN WITH NO RHYTHM.
15600	BD:	MOVEM 2,KBD#	;'KBD' WILL BE 'K'
15700		JSA 16,CODEN	;   R=CODEN(KPN,K,Q,JD)
15800		JUMP PX		; /PX/ IS KPN
15900		JUMP KBD 	; 'K'
16000		JUMP Q
16100		JUMP JD# 	;  'JD'
16200		CAMLE [3.0] 	;	   IF(R.GT.3.)GO TO 112
16300		JRST B112
16400		MOVE 4,[1.0]	;	   A=1.0
16500		CAMN [2.0]	; CHECKS FOR NUMBER OF NOTES, RESTS, CLEFS.
16600		MOVE 4,[0.6]	;AC0 IS R      IF(R.EQ.2)A=0.6
16700	; SKIP NON-RHYTHM CHORD NOTES.   RESTS ARE CONSIDERED LESS IMPORTANT.
16800		MOVE 11,JD  	; GET POINTER TO ITEM IN Q ARRAY
16900		CAME [1.0]	;   IF(R.NE.1)GO TO 4112
17000		JRST B4112
17100		CAMG 7,Q-1(11)	;   IF(Q(JD).LT.7)GO TO 112
17200		SKIPG Q+8(11)	;   IF(Q(JD+9).LE.0)GO TO 112
17300		JRST B112
17400	B4112:	KIFIX 12,Q+1(11)	;4112	   LF=Q(JD+2)+1
17500		FADRM 4,XRN(12)	        ;  RN(LF)=RN(LF)+A 
17600	B112:	AOJ 2,			;112	   CONTINUE
17700		CAMGE 2,JN		;/JN/ IS J
17800		JRST BD
17900		SETZ  2, 		;	   JD=1
18000		MOVE 3,XRN		;   B=RN(1)*RSTFAC(1)
18100		FMPR 3,STF
18200		MOVEI 4,1		; 	   DO 2112 K=2,KPG
18300	BE:	MOVE 5,XRN(4)		;   A=RN(K)*RSTFAC(K)
18400		FMPR 5,STF(4)
18500		CAMG 5,3		;    	   IF(A.LE.B)GO TO 2112
18600		JRST B2112
18700		MOVE 2,4		; (-1)   JD=K
18800		MOVE 3,5		;   B=A
18900	B2112:	AOJ 4,			;2112	   CONTINUE
19000		CAME 4,@(16)
19100		JRST BE
19200		MOVE 2,STF(2)		;   BFAC=BFAC*(RSTFAC(JD)+.1)
19300		FADR 2,[0.1]	; +.1 ABOVE TO MINIMIZE DIFF. IN SIZE FACTOR.
19400		FMPRM 2,@1(16)
19500		JRA 16,2(16)		;RETURN
19600	
19700	; WRITES AND READS DUMP MODE FILES WITH ANY EXTENSION.
19800		CH3←12
19900		CH2←11
20000		BLKS←←=1
20100	
20200	;CALL PUTEXT(<FILE>,<EXT>)
20300	
20400	PUTEXT:	0	;USES EXTOUT,FINEXT, CH2
20500		MOVE 0,@0(16)
20600		MOVEM 0,FILNAM
20700		MOVE 0,@1(16)
20800		MOVEM 0,EXTNAM
20900		JSA 16,INTFIL
21000		SETZM DIR+2
21100		SETZM DIR+3
21200		ENTER CH2,DIR
21300		ERROR <ENTER FAILED>
21400		JRA 16,2(16)
21500	
21600	;CALL EXTOUT(<ARRAY>,<NO. OF WORDS>)
21700	
21800	EXTOUT:	0
21900		HRRZI 0,@0(16)
22000		SUBI 0,1
22100		MOVEM 0,COM
22200		MOVN 0,@1(16)
22300		HRLM 0,COM
22400		OUTPUT CH2,COM
22500		STATZ CH2,740000
22600		ERROR <WRITE ERROR>
22700		JRA 16,2(16)
22800	
22900	
23000	INTFIL:	0	;INITS DSK 
23100		MOVEI REGS
23200		BLT REGS+3
23300		INIT CH2,17
23400		SIXBIT/DSK/
23500		0
23600		ERROR <CAN'T INIT DSK!>
23700	EXTF4:	PUSHJ 17,INTF4
23800	;NEXT IS NEAR TOP OF FILE.********
23900	;INTF4:	MOVE 0,FILNAM#
24000	;	MOVEM 0,FN#
24100	;	MOVE 1,[POINT 7,FN]
24200	;INTF3:	MOVE 2,[POINT 6,DIR]
24300	;	SETZM DIR
24400	;	MOVEI 3,5
24500	;INTF1:	ILDB 0,1
24600	;	CAIN 0," "
24700	;	JRST INTF2
24800	;	SUBI 0,40
24900	;	IDPB 0,2
25000	;	SOJG 3,INTF1
25100	;INTF2:	HRLZI REGS
25200	;	BLT 3
25300		MOVE 0,EXTNAM#
25400		MOVEM 0,EX#
25500		MOVE 1,[POINT 7,EX]
25600	EXTF3:	MOVE 2,[POINT 6,DIR+1]
25700		SETZM DIR+1
25800		MOVEI 3,5
25900	EXTF1:	ILDB 0,1
26000		CAIN 0," "
26100		JRST EXTF2
26200		SUBI 0,40
26300		IDPB 0,2
26400		SOJG 3,EXTF1
26500	EXTF2:	HRLZI REGS
26600		BLT 3
26700		JRA 16,0(16)
26800	
26900	
27000	COM:	OCT 0,0
27100	COM1:	0
27200	BLKNUM:	0
27300	
27400	;CALL FINEXT
27500	FINEXT:	0
27600		CLOSE CH2,0
27700		STATZ CH2,740000
27800		ERROR <ERROR AFTER CLOSE>
27900		RELEASE CH2,0
28000		JRA 16,0(16)
28100	
28200	;CALL GETEXT(<FILE>,<EXT>)
28300	
28400	GETEXT:	0
28500		MOVE 0,@0(16)
28600		MOVEM 0,FILNAM
28700		MOVE 0,@1(16)
28800		MOVEM 0,EXTNAM
28900		JSA 16,INTFIZ
29000		SETZM DIR+3
29100		SETZM DIR+2
29200		LOOKUP CH3,DIR
29300		ERROR <LOOKUP FAILED>
29400		JRA 16,2(16)
29500	
29600	
29700	INTFIZ:	0	;INITS DSK FOR INPUT
29800		MOVEI REGS
29900		BLT REGS+3
30000		INIT CH3,17
30100		SIXBIT/DSK/
30200		0
30300		ERROR <CAN'T INIT DSK!>
30400	;;	JRST INTF4
30500		JRST EXTF4
30600	
30700	
30800	;CALL FASTI2(<ARRAY>,<NO. WORDS>)
30900	
31000	EXTIN:	0
31100		HRRZI 0,@0(16)
31200		SUBI 0,1
31300		MOVEM 0,COM
31400		MOVN 0,@1(16)
31500		HRLM 0,COM
31600		INPUT CH3,COM
31700		STATZ CH3,740000
31800		0
31900		JRA 16,2(16)
32000	           
32100		END